Here’s our starting notebook analysis of the Health Canada nutrient
dataset
library(ggplot2)
library(dplyr)
library(plotly)
# What's in this Rdata file: save(ca_conversion_factor, ca_food_choices, ca_food_group, ca_food_name, ca_food_source, ca_measure_name, ca_nutrient_amount, ca_nutrient_name, ca_nutrient_source, ca_refuse_amount, ca_refuse_name, ca_yield_amount, ca_yield_name, daily_value, file = "nutrient_data.Rdata")
load("../data/nutrient_data.Rdata")
We’ve got our data loaded, now what do we want to know?
ca_food_group
head(ca_food_name)
NA
What do my daily coffee macros look like?
#I'll need the ingredients, the amounts, and their respective macronutrients
food_choice <- "Coffee, brewed, prepared with tap water"
food_amount <- 250
measure_df <- ca_food_name %>%
filter(FoodDescription == food_choice) %>%
select(FoodID) %>%
left_join(ca_conversion_factor) %>%
left_join(ca_measure_name) %>%
select(numeric, units, description, ConversionFactorValue, MeasureID, FoodID)
measure_food_df <- measure_df %>%
filter(numeric == min(numeric)) %>%
left_join(ca_nutrient_amount) %>%
left_join(ca_nutrient_name) %>%
mutate(NutrientName = tolower(NutrientName)) %>%
mutate(NutrientValue = NutrientValue * ConversionFactorValue * food_amount / numeric) %>%
select(NutrientName, NutrientValue, NutrientID, NutrientUnit, ConversionFactorValue, FoodID) %>%
group_by(NutrientName) %>%
summarize(Value = round(sum(NutrientValue, na.rm = T), digits = 2),
Unit = NutrientUnit,
NutrientID = NutrientID)
select_nutrients <- c("calcium", "carbohydrate, total (by difference)", "cholesterol", "energy (kilocalories)", "fat (total lipids)", "fatty acids, saturated, total", "fatty acids, trans, total", "fibre, total dietary", "iron", "protein", "retinol activity equivalents", "sodium", "sugars, total", "vitamin c")
macro_df <- measure_food_df %>% filter(NutrientName %in% select_nutrients) %>%
select(NutrientName, NutrientID, Value, Unit) %>%
arrange(-Value)
scaled_macro_df <- daily_value %>%
left_join(macro_df) %>%
filter(Group == "macronutrients") %>%
mutate(Scaled_dv = round(Value/DV, digits = 3) * 100) %>%
na.omit()
#look at our dataframe
scaled_macro_df
#get rid of funky unit name that causes issues
scaled_macro_df[scaled_macro_df$Unit == "\xb5g", "Unit"] <- "g"
nutrient_plot <- ggplot(scaled_macro_df) +
geom_bar(stat = "identity", aes(x = reorder(NutrientName, Scaled_dv), Scaled_dv)) +
xlab("Nutrient name") +
ylab("% Daily value") +
coord_flip()
nutrient_plot

#interactive version of the plot with the value as a hovering tooltip
ggplotly(nutrient_plot, tooltip = "y")
NA
What does my daily coffee mineral intake look like?
scaled_mineral_df <- daily_value %>%
left_join(macro_df) %>%
filter(Group == "mineral") %>%
mutate(Scaled_dv = round(Value/DV, digits = 3) * 100) %>%
na.omit()
#look at our dataframe
scaled_mineral_df
#get rid of funky unit name that causes issues
scaled_mineral_df[scaled_mineral_df$Unit == "\xb5g", "Unit"] <- "g"
mineral_plot <- ggplot(scaled_mineral_df) +
geom_bar(stat = "identity", aes(x = reorder(NutrientName, Scaled_dv), Scaled_dv)) +
xlab("Mineral name") +
ylab("% Daily value") +
coord_flip()
mineral_plot

#interactive version of the plot with the value as a hovering tooltip
ggplotly(mineral_plot, tooltip = "y")
NA
All right, so we’ve used the Health Canada dataset to produce some
tables and plots for nutrient info pertaining to a serving of coffee.
The code works, but are we really just going to copy and paste the it
for every food ingredient we want to know about?
Maybe we could wrap our code in a function that takes the food name
as input and returns all of our tables and figures. What do we do if we
want to add multiple ingredients together, though? It’s clear that our
notebook approach to this dataset doesn’t really scale well. This is
where Shiny comes in to play. We can replace the hard-coded ingredient
text that with an active input that updates our plots and tables when we
change our ingredient.
LS0tCnRpdGxlOiAiTnV0cmllbnQgZGF0YSIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyBIZXJlJ3Mgb3VyIHN0YXJ0aW5nIG5vdGVib29rIGFuYWx5c2lzIG9mIHRoZSBIZWFsdGggQ2FuYWRhIG51dHJpZW50IGRhdGFzZXQKCmBgYHtyIGxpYnJhcmllcyBhbmQgZGF0YSBpbXBvcnRpbmcsIG1lc3NhZ2UgPSBGQUxTRX0KbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KGRwbHlyKQpsaWJyYXJ5KHBsb3RseSkKCiMgV2hhdCdzIGluIHRoaXMgUmRhdGEgZmlsZTogc2F2ZShjYV9jb252ZXJzaW9uX2ZhY3RvciwgY2FfZm9vZF9jaG9pY2VzLCBjYV9mb29kX2dyb3VwLCBjYV9mb29kX25hbWUsIGNhX2Zvb2Rfc291cmNlLCBjYV9tZWFzdXJlX25hbWUsIGNhX251dHJpZW50X2Ftb3VudCwgY2FfbnV0cmllbnRfbmFtZSwgY2FfbnV0cmllbnRfc291cmNlLCBjYV9yZWZ1c2VfYW1vdW50LCBjYV9yZWZ1c2VfbmFtZSwgY2FfeWllbGRfYW1vdW50LCBjYV95aWVsZF9uYW1lLCBkYWlseV92YWx1ZSwgZmlsZSA9ICJudXRyaWVudF9kYXRhLlJkYXRhIikKCmxvYWQoIi4uL2RhdGEvbnV0cmllbnRfZGF0YS5SZGF0YSIpCmBgYAoKIyBXZSd2ZSBnb3Qgb3VyIGRhdGEgbG9hZGVkLCBub3cgd2hhdCBkbyB3ZSB3YW50IHRvIGtub3c/CgpgYGB7ciBleHBsb3JlIHRoZSBzdHJ1Y3R1cmUgb2YgdGhlIGRhdGEgYSBiaXQsIG1lc3NhZ2UgPSBGQUxTRX0KCmNhX2Zvb2RfZ3JvdXAKaGVhZChjYV9mb29kX25hbWUpCgpgYGAKCiMgV2hhdCBkbyBteSBkYWlseSBjb2ZmZWUgbWFjcm9zIGxvb2sgbGlrZT8KYGBge3Igd2hhdCBkbyBteSBkYWlseSBjb2ZmZWUgbWFjcm9zIGxvb2sgbGlrZSwgbWVzc2FnZSA9IEZBTFNFfQoKI0knbGwgbmVlZCB0aGUgaW5ncmVkaWVudHMsIHRoZSBhbW91bnRzLCBhbmQgdGhlaXIgcmVzcGVjdGl2ZSBtYWNyb251dHJpZW50cwpmb29kX2Nob2ljZSA8LSAiQ29mZmVlLCBicmV3ZWQsIHByZXBhcmVkIHdpdGggdGFwIHdhdGVyIgpmb29kX2Ftb3VudCA8LSAyNTAKCm1lYXN1cmVfZGYgPC0gY2FfZm9vZF9uYW1lICU+JQogIGZpbHRlcihGb29kRGVzY3JpcHRpb24gPT0gZm9vZF9jaG9pY2UpICU+JSAKICBzZWxlY3QoRm9vZElEKSAlPiUKICBsZWZ0X2pvaW4oY2FfY29udmVyc2lvbl9mYWN0b3IpICU+JSAKICBsZWZ0X2pvaW4oY2FfbWVhc3VyZV9uYW1lKSAlPiUgCiAgc2VsZWN0KG51bWVyaWMsIHVuaXRzLCBkZXNjcmlwdGlvbiwgQ29udmVyc2lvbkZhY3RvclZhbHVlLCBNZWFzdXJlSUQsIEZvb2RJRCkgCgptZWFzdXJlX2Zvb2RfZGYgPC0gbWVhc3VyZV9kZiAlPiUKICBmaWx0ZXIobnVtZXJpYyA9PSBtaW4obnVtZXJpYykpICU+JQogICAgICBsZWZ0X2pvaW4oY2FfbnV0cmllbnRfYW1vdW50KSAlPiUKICAgICAgbGVmdF9qb2luKGNhX251dHJpZW50X25hbWUpICU+JQogICAgICBtdXRhdGUoTnV0cmllbnROYW1lID0gdG9sb3dlcihOdXRyaWVudE5hbWUpKSAlPiUKICAgICAgbXV0YXRlKE51dHJpZW50VmFsdWUgPSBOdXRyaWVudFZhbHVlICogQ29udmVyc2lvbkZhY3RvclZhbHVlICogZm9vZF9hbW91bnQgLyBudW1lcmljKSAlPiUKICAgIHNlbGVjdChOdXRyaWVudE5hbWUsIE51dHJpZW50VmFsdWUsIE51dHJpZW50SUQsIE51dHJpZW50VW5pdCwgQ29udmVyc2lvbkZhY3RvclZhbHVlLCBGb29kSUQpICU+JSAKICAgICAgZ3JvdXBfYnkoTnV0cmllbnROYW1lKSAlPiUgCiAgICAgIHN1bW1hcml6ZShWYWx1ZSA9IHJvdW5kKHN1bShOdXRyaWVudFZhbHVlLCBuYS5ybSA9IFQpLCBkaWdpdHMgPSAyKSwKICAgICAgICAgICAgICAgIFVuaXQgPSBOdXRyaWVudFVuaXQsCiAgICAgICAgICAgICAgICBOdXRyaWVudElEID0gTnV0cmllbnRJRCkKICAKc2VsZWN0X251dHJpZW50cyA8LSBjKCJjYWxjaXVtIiwgImNhcmJvaHlkcmF0ZSwgdG90YWwgKGJ5IGRpZmZlcmVuY2UpIiwgImNob2xlc3Rlcm9sIiwgImVuZXJneSAoa2lsb2NhbG9yaWVzKSIsICJmYXQgKHRvdGFsIGxpcGlkcykiLCAiZmF0dHkgYWNpZHMsIHNhdHVyYXRlZCwgdG90YWwiLCAiZmF0dHkgYWNpZHMsIHRyYW5zLCB0b3RhbCIsICJmaWJyZSwgdG90YWwgZGlldGFyeSIsICJpcm9uIiwgInByb3RlaW4iLCAicmV0aW5vbCBhY3Rpdml0eSBlcXVpdmFsZW50cyIsICJzb2RpdW0iLCAic3VnYXJzLCB0b3RhbCIsICJ2aXRhbWluIGMiKQogICAKbWFjcm9fZGYgPC0gbWVhc3VyZV9mb29kX2RmICU+JSBmaWx0ZXIoTnV0cmllbnROYW1lICVpbiUgc2VsZWN0X251dHJpZW50cykgJT4lCiAgc2VsZWN0KE51dHJpZW50TmFtZSwgTnV0cmllbnRJRCwgVmFsdWUsIFVuaXQpICU+JQogIGFycmFuZ2UoLVZhbHVlKQoKc2NhbGVkX21hY3JvX2RmIDwtIGRhaWx5X3ZhbHVlICU+JSAKICBsZWZ0X2pvaW4obWFjcm9fZGYpICU+JQogIGZpbHRlcihHcm91cCA9PSAibWFjcm9udXRyaWVudHMiKSAlPiUKICBtdXRhdGUoU2NhbGVkX2R2ID0gcm91bmQoVmFsdWUvRFYsIGRpZ2l0cyA9IDMpICogMTAwKSAlPiUKICBuYS5vbWl0KCkKICAKI2xvb2sgYXQgb3VyIGRhdGFmcmFtZQpzY2FsZWRfbWFjcm9fZGYKCiNnZXQgcmlkIG9mIGZ1bmt5IHVuaXQgbmFtZSB0aGF0IGNhdXNlcyBpc3N1ZXMKc2NhbGVkX21hY3JvX2RmW3NjYWxlZF9tYWNyb19kZiRVbml0ID09ICJceGI1ZyIsICJVbml0Il0gPC0gImciCiAgCm51dHJpZW50X3Bsb3QgPC0gZ2dwbG90KHNjYWxlZF9tYWNyb19kZikgKwogIGdlb21fYmFyKHN0YXQgPSAiaWRlbnRpdHkiLCBhZXMoeCA9IHJlb3JkZXIoTnV0cmllbnROYW1lLCBTY2FsZWRfZHYpLCBTY2FsZWRfZHYpKSArCiAgeGxhYigiTnV0cmllbnQgbmFtZSIpICsKICB5bGFiKCIlIERhaWx5IHZhbHVlIikgKwogIGNvb3JkX2ZsaXAoKQoKbnV0cmllbnRfcGxvdAoKI2ludGVyYWN0aXZlIHZlcnNpb24gb2YgdGhlIHBsb3Qgd2l0aCB0aGUgdmFsdWUgYXMgYSBob3ZlcmluZyB0b29sdGlwCmdncGxvdGx5KG51dHJpZW50X3Bsb3QsIHRvb2x0aXAgPSAieSIpCgpgYGAKCiMgV2hhdCBkb2VzIG15IGRhaWx5IGNvZmZlZSBtaW5lcmFsIGludGFrZSBsb29rIGxpa2U/CmBgYHtyIHdoYXQgZG9lcyBteSBkYWlseSBjb2ZmZWUgbWluZXJhbCBpbnRha2UgbG9vayBsaWtlLCBtZXNzYWdlID0gRkFMU0V9CgpzY2FsZWRfbWluZXJhbF9kZiA8LSBkYWlseV92YWx1ZSAlPiUgCiAgbGVmdF9qb2luKG1hY3JvX2RmKSAlPiUKICBmaWx0ZXIoR3JvdXAgPT0gIm1pbmVyYWwiKSAlPiUKICBtdXRhdGUoU2NhbGVkX2R2ID0gcm91bmQoVmFsdWUvRFYsIGRpZ2l0cyA9IDMpICogMTAwKSAlPiUKICBuYS5vbWl0KCkKICAKI2xvb2sgYXQgb3VyIGRhdGFmcmFtZQpzY2FsZWRfbWluZXJhbF9kZgoKI2dldCByaWQgb2YgZnVua3kgdW5pdCBuYW1lIHRoYXQgY2F1c2VzIGlzc3VlcwpzY2FsZWRfbWluZXJhbF9kZltzY2FsZWRfbWluZXJhbF9kZiRVbml0ID09ICJceGI1ZyIsICJVbml0Il0gPC0gImciCiAgCm1pbmVyYWxfcGxvdCA8LSBnZ3Bsb3Qoc2NhbGVkX21pbmVyYWxfZGYpICsKICBnZW9tX2JhcihzdGF0ID0gImlkZW50aXR5IiwgYWVzKHggPSByZW9yZGVyKE51dHJpZW50TmFtZSwgU2NhbGVkX2R2KSwgU2NhbGVkX2R2KSkgKwogIHhsYWIoIk1pbmVyYWwgbmFtZSIpICsKICB5bGFiKCIlIERhaWx5IHZhbHVlIikgKwogIGNvb3JkX2ZsaXAoKQoKbWluZXJhbF9wbG90CgojaW50ZXJhY3RpdmUgdmVyc2lvbiBvZiB0aGUgcGxvdCB3aXRoIHRoZSB2YWx1ZSBhcyBhIGhvdmVyaW5nIHRvb2x0aXAKZ2dwbG90bHkobWluZXJhbF9wbG90LCB0b29sdGlwID0gInkiKQoKYGBgCgpBbGwgcmlnaHQsIHNvIHdlJ3ZlIHVzZWQgdGhlIEhlYWx0aCBDYW5hZGEgZGF0YXNldCB0byBwcm9kdWNlIHNvbWUgdGFibGVzIGFuZCBwbG90cyBmb3IgbnV0cmllbnQgaW5mbyBwZXJ0YWluaW5nIHRvIGEgc2VydmluZyBvZiBjb2ZmZWUuIFRoZSBjb2RlIHdvcmtzLCBidXQgYXJlIHdlIHJlYWxseSBqdXN0IGdvaW5nIHRvIGNvcHkgYW5kIHBhc3RlIHRoZSBpdCBmb3IgZXZlcnkgZm9vZCBpbmdyZWRpZW50IHdlIHdhbnQgdG8ga25vdyBhYm91dD8gCgpNYXliZSB3ZSBjb3VsZCB3cmFwIG91ciBjb2RlIGluIGEgZnVuY3Rpb24gdGhhdCB0YWtlcyB0aGUgZm9vZCBuYW1lIGFzIGlucHV0IGFuZCByZXR1cm5zIGFsbCBvZiBvdXIgdGFibGVzIGFuZCBmaWd1cmVzLiBXaGF0IGRvIHdlIGRvIGlmIHdlIHdhbnQgdG8gYWRkIG11bHRpcGxlIGluZ3JlZGllbnRzIHRvZ2V0aGVyLCB0aG91Z2g/IEl0J3MgY2xlYXIgdGhhdCBvdXIgbm90ZWJvb2sgYXBwcm9hY2ggdG8gdGhpcyBkYXRhc2V0IGRvZXNuJ3QgcmVhbGx5IHNjYWxlIHdlbGwuIFRoaXMgaXMgd2hlcmUgU2hpbnkgY29tZXMgaW4gdG8gcGxheS4gV2UgY2FuIHJlcGxhY2UgdGhlIGhhcmQtY29kZWQgaW5ncmVkaWVudCB0ZXh0IHRoYXQgd2l0aCBhbiBhY3RpdmUgaW5wdXQgdGhhdCB1cGRhdGVzIG91ciBwbG90cyBhbmQgdGFibGVzIHdoZW4gd2UgY2hhbmdlIG91ciBpbmdyZWRpZW50Lgo=